perm filename RESTX.F4[RST,LCS] blob
sn#180069 filedate 1975-10-08 generic text, type T, neo UTF8
00100 SUBROUTINE RESTS(PN,Q)
00500 COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00600 COMMON /LLL/L,LL,I,IX
00650 DIMENSION PN(1),Q(1)
00700 EQUIVALENCE (RQ(10),XLFT),(K,RQ(3)),(RR,RQ(4)),(LB,RQ(5))
00900 XLFT=0
00910 SIG=-99
00955 CLEF=-99
01000 REST=0
01100 K=1
01200 50 JL=PN(K)
01300 R=Q(JL+1)
01400 IF(XLFT.NE.0)GO TO 2
01500 IF(R.LE.4)XLFT=Q(JL+3)
01546
01550 2 IF(R.NE.3)GO TO 5
01554 RR=Q(JL+5)
01558 IF(Q(JL).LT.3)RR=0
01562 IF(RR.NE.CLEF)GO TO 3
01574
01578 60 Q(JL+1)=-1
01582 GO TO 231
01586 5 IF(R.NE.17)GO TO 3
01590 IF(Q(JL+5).EQ.SIG)GO TO 60
01594 SIG=Q(JL+5)
01600 3 IF(R.NE.2)GO TO 231
01700 IF(Q(JL).GE.6)GO TO 7
01710 IF(Q(IFIX(PN(K-1))+1).NE.4)GO TO 231
01730 C ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
01740 C WON'T CATCH IT IF TERE IS A CLEF, METER, ETC. PRESENT
01750 IF(Q(IFIX(PN(K+1))+1).NE.4)GO TO 231
01800 C FOUND A WHOLE REST MEAS.
01900 7 IF(REST.NE.0)GO TO 6
02000 JR=JL+8
02100 C POINTER TO REST NUM.
02110 R=Q(JR-1)
02120 IF(R.LT.5)R=5
02200 Q(JR-1)=R*.6
02300 C REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
02400 6 REST=REST+1
02500 Q(JR)=REST
02600 JL=K+2
02700 IF(JL.GE.L)RETURN
02710 CC LC=PN(K+1)
02755 CC IF(Q(LC+1))JL=JL+1
02760 C WAS THERE AN EXTRA BAR?
02800 LB=PN(JL)
02900 IF(Q(LB+1).NE.2)GO TO 233
03000 C NEXT IS TO COMBINE MEASURES OF REST
03100 IF(Q(LB).LT.6)GO TO 233
03200 C SKIP NON-WHOLE RESTS
03300 N=PN(JL-1)
03400 IF(Q(N+1).NE.4)GO TO 233
03500 C IS REST FOLLOWED BY A BAR?
03700 C SO IT WON'T BE FOUND NEXT TIME AROUND.
03800 Q(LB+1)=-1
03900 C CHANGE CODE #
04000 Q(N+1)=-1
04100 K=JL
04200 GO TO 6
04300
04400 233 REST=0
04500 231 K=K+1
04600 IF(K.LT.L)GO TO 50
04700 END
04800
04900
05000 CC SUBROUTINE ADDRST(RPOS,XWDS,PN)
05100 CC COMMON /XXX/LK,LP,JY /LLL/L,LL,I,IX
05400 CC COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
05600 CC DIMENSION XWDS(1),PN(1)
05900 CC PN(LK)=6
06000 CC PN(LK+1)=2
06100 CC PN(LK+2)=RS
06200 CC PN(LK+3)=RPOS-1.
06300 CC PN(LK+4)=0
06400 CC PN(LK+5)=0
06500 CC PN(LK+6)=0
06600 CC PN(LK+7)=6.
06700 CC PN(LK+8)=-1
06800 CC LK=LK+9
06900 CC L=L+1
07000 CC XWDS(L)=LK
07100 C NEXT ADDS A BAR LINE
07300 CC PN(LK)=2
07400 CC PN(LK+1)=4
07500 CC PN(LK+2)=RS
07600 CC PN(LK+3)=RPOS
07700 CC PN(LK+4)=1.
07800 CC LK=LK+5
07900 CC L=L+1
08000 CC XWDS(L)=LK
08200 CC END